home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / prtcs155.zip / ACVT.WPL next >
Text File  |  1994-01-14  |  2KB  |  48 lines
  1. /**/
  2. v="$VER: Acvt Wplrx Convert Emsi to Wpl, Fix domains Williamson 55.00"
  3. /*
  4.  Converts  a list of 3d, 4d or 5d EMSI formatted addresses 
  5.     zone:net/node[.point][@domain[.org|ftn]]
  6.  to wpl format 
  7.     domain#zone:net/node.point
  8.  Also corrects DOMAIN.
  9.     
  10.  RexxMsg "" REXX "$(rexxdir)acvt.wplrx $(remote.addresses)"
  11. */
  12. dl="FIDONET 1 FIDONET 2 FIDONET 3 FIDONET 4 FIDONET 5 FIDONET 6 AMIGANET 38 AMIGANET 39 AMIGANET 40 FRANCOMEDIA 101 MTLNET 17 CJNET 100"
  13.  
  14. parse upper arg x
  15. new=""
  16. do i=1 to words(x)
  17.     y=word(x,i)
  18.     if left(right(y,4),1)="." & datatype(right(y,3),'Mixed') then y=delstr(y,lastpos('.',y),4)
  19.     if pos('.',y) > 0 then do
  20.         if pos('@',y)>0 then do
  21.             parse var y z':'n'/'f'.'p'@'d
  22.             if (pos(z,"1 2 3 4 5 6")>0 & d~="FIDONET") | (pos(z,"1 2 3 4 5 6")=0 & d="FIDONET")  then d=find_domain(z)
  23.             if d~=find_domain(z) then d=find_domain(z)
  24.             new=new||d'#'z':'n'/'f'.'p' '
  25.         end;else do
  26.             parse var y z':'n'/'f'.'p
  27.             new=new||find_domain(z)'#'z':'n'/'f'.'p' '
  28.         end
  29.     end;else do
  30.         if pos('@',y)>0 then do
  31.             parse var y z':'n'/'f'@'d
  32.             if (pos(z,"1 2 3 4 5 6")>0 & d~="FIDONET") | (pos(z,"1 2 3 4 5 6")=0 & d="FIDONET")  then d=find_domain(z)
  33.             if d~=find_domain(z) then d=find_domain(z)
  34.             new=new||d'#'z':'n'/'f'.0 '
  35.         end;else do
  36.             parse var y z':'n'/'f
  37.             new=new||find_domain(z)'#'z':'n'/'f'.0 '
  38.         end
  39.     end
  40. end
  41. 'Set remote.addresses "'new'"'
  42. exit
  43.  
  44. find_domain: procedure expose dl
  45. dz=FIND(dl,arg(1))
  46. if dz=0 then return "UNKNOWN"
  47. else return strip(word(dl,dz-1))
  48.